# $Id: ThenNow.pm,v 1.1.1.1 2004/02/21 18:48:08 ibo Exp $

package CGI::FOGE2::ThenNow;
use strict;

our @ISA = qw(CGI::FOGE2::MultQuestion);

use CGI::FOGE2::Tools;
use CGI::FOGE2::Stats;
#use Data::Dumper;

=head1 NAME

ThenNow - a FOGE question where an indexed array of choices is displayed.

=head1 DESCRIPTION

This FOGE question is used to display a choice between several items
where rows are indexed with some labels. It is mainly used to ask
a question that may look like:

                                         +------+-----+--------+
 Choose your                             | blue | red | yellow |
 favorite                 +--------------+------+-----+--------+
 color:                   | at that time |  X   |     |        |
                          | today        |      |     |   X    |
                          +--------------+------+-----+--------+

In this question, you may choose your favorite color then or now.

Mandatory additional (See CGI::FOGE2::MultQuestion for inherited
parameters) parameters for C<new> are:

=over 4

=item * periods 

An array of hashes {id => '', title => ''}. The identifier C<id>
(valid for Perl, HTML and sql) participates to the label used to
retain the value, C<title> is a string to index the row. For instance,
the question shown above in ascii-art (with radio-buttons) is built
with:

  new CGI::FOGE2::ThenNow(
       id => 'someId',
       ismandatory => 1, # if needed
       title => 'Choose your favorite color:',
       items => ['blue', 'red', 'yellow'],
       periods => [ { id => 'then', title => 'At that time' },
                    { id => 'now', title => 'Today' } ]);

=back

=head1 BUGS

The inherited C<ismultiple> parameter might work.  

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my %args = @_;
    my @mandatory_keys = ('title', 'items', 'periods', 'id');
    my $self =
      {
       id            => undef,  # autogen (?)
#      default       => undef,	# the default item (was: initial)
       items         => undef,  # an array of items (was: choice)
       periods       => undef,  # an array of labels
       title         => undef,	# was: label
       ismultiple    => 0,      # That is, radio-buttons
       html_type     => 'radio_group',
       rows          => 1,
       columns       => undef,
       ismandatory   => 0,
       isvalidregexp => undef,
       validate      => undef,  # func. returning string or false
       stats         => undef,
      };

    bless ($self, $class);
    $self->_construct(\%args, \@mandatory_keys);
    $self->{columns} = 1+$#{@{$self->{items}}} 
        unless defined($self->{columns});
    $self->{html_type} = 'checkbox_group' if $self->{ismultiple};
    # By default, as many stats as there are periods:
    if ( !defined $self->{stats} ) {
        $self->{stats} = ();
        foreach my $period ( @{$self->{periods}} ) {
            my $stat = CGI::FOGE2::StatsSimple->new();
            $stat->setcolumns([$period->{id} . "_" . $self->{id}]);
            $stat->{caption} = $period->{title};
            push @{$self->{stats}}, $stat;
        }
    };
    return $self->init();
}

sub generate_field_names {
    my $self = shift;
    my $id = $self->{id};
    my @names;
    foreach my $period ( @{$self->{periods}} ) {
        push @names, $period->{id} . "_" . $id;
    }
    return [ @names ];
}

sub serve {
    my $self = shift;
    my $id = $self->{id};
    my $fn = \&{"CGI::" . $self->{html_type}};
    my @rows;
    #print "<!-- ", Dumper($self), " -->"; # DEBUG
    foreach my $period ( @{$self->{periods}} ) {
        my %line = (-values => $self->{items},
                    -name => $period->{id} . "_" . $id,
                    -rows => $self->{rows},
                    -columns => $self->{columns},
                    );
        if (defined $self->{default}) {
            $line{-default} = $self->{default};
        } else {
            $line{-default} = '-'; # deselect all buttons
        }
        push @rows, CGI::Tr(CGI::th($period->{title}) . CGI::td(&$fn(%line)));
    }
    return table3cols($self->{title},
		      $self->{ismandatory},
		      CGI::table({}, @rows));
}

# Sort the result of stats->computedata() along the order suggested by
# the items of the question. Code similar to RadioButton.pm
# NOTE: This code is weird since it takes care of item modification when
# the FOGE form evolves but still old statistical results are extracted
# from the database.

#QNC: FUTURE concentrate this method somewhere ? (create an abstract
#class OrderedQuestion with an items field ?)                          FUTURE

sub sort {
    my $self = shift;
    my ($number, $total, $names, $vals) = @_;
    my (@lost_names, @lost_vals);

    # Initialize in right order:
    my (@new_names, @new_vals);
    foreach ( @{$self->{items}} ) {
        push @new_names, $_;
        push @new_vals, 0;
    }

    # Update with collected results:
    N:
    for ( my $i=0 ; $i<@{$names} ; $i++ ) {
        for ( my $j=0 ; $j<@{$self->{items}} ; $j++ ) {
            if ( $self->{items}->[$j] eq $names->[$i] ) {
                $new_names[$j] = $names->[$i];
                $new_vals[$j] = $vals->[$i];
                next N;
            };
        }
        # Append lost items (and their corresponding values):
        push @lost_names, $names->[$i];
        push @lost_vals, $vals->[$i];
    }

    return ($number, $total, 
            [@new_names, @lost_names], 
            [@new_vals, @lost_vals] );
}

1;

# end of ThenNow.pm
